home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / msds-prl / bcdsprl1.zoo / lib / getopts.pl < prev    next >
Text File  |  1991-11-13  |  976b  |  50 lines
  1. ;# getopts.pl - a better getopt.pl
  2.  
  3. ;# Usage:
  4. ;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
  5. ;#                           #  side effect.
  6.  
  7. sub Getopts {
  8.     local($argumentative) = @_;
  9.     local(@args,$_,$first,$rest);
  10.     local($errs) = 0;
  11.     local($[) = 0;
  12.  
  13.     @args = split( / */, $argumentative );
  14.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  15.     ($first,$rest) = ($1,$2);
  16.     $pos = index($argumentative,$first);
  17.     if($pos >= $[) {
  18.         if($args[$pos+1] eq ':') {
  19.         shift(@ARGV);
  20.         if($rest eq '') {
  21.             $rest = shift(@ARGV);
  22.         }
  23.         eval "\$opt_$first = \$rest;";
  24.         }
  25.         else {
  26.         eval "\$opt_$first = 1";
  27.         if($rest eq '') {
  28.             shift(@ARGV);
  29.         }
  30.         else {
  31.             $ARGV[0] = "-$rest";
  32.         }
  33.         }
  34.     }
  35.     else {
  36.         print STDERR "Unknown option: $first\n";
  37.         ++$errs;
  38.         if($rest ne '') {
  39.         $ARGV[0] = "-$rest";
  40.         }
  41.         else {
  42.         shift(@ARGV);
  43.         }
  44.     }
  45.     }
  46.     $errs == 0;
  47. }
  48.  
  49. 1;
  50.